<html>
  <head>
    <script type="text/javascript" src="js/biginteger.js"></script>
    <script type="text/javascript" src="js/substandard_lisp.js"></script>
    <script type="text/substandard-lisp">
% slbrainfuck - substandard lisp brainfuck interpreter
% author: Nicky Nickell <nicky.nickell@gmail.com>

(setq *OUTPUT nil)
(setq helloworld "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")

(de range (start end)
  (cond ((greaterp start end)
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (sub1 start) end)))))
        (t
         (cond ((eqn start end) (cons end nil))
               (t (cons start (range (add1 start) end)))))))

(de bfseek (bfp from direction for)
  (prog nil
    (mapc (if (minusp direction) 
            (range 0 from)
            (range from (length bfp)))
      (lambda (i)
        (if (eqn (nth i bfp) for) (return i))))))

(de bf (bfp bfi)
  (let ((ptr 0)
        (pc 0)
        (bfout nil)
        (memory (make-vector 200 0))
        (bfin (string-to-list bfi))
        (bfprog (string-to-list bfp)))
    (prog (op)
top   (setq op (nth pc bfprog))
      (cond ((eqn op (char !>))
             (setq ptr (add1 ptr)))
            ((eqn op (char !<)) 
             (setq ptr (sub1 ptr)))
            ((eqn op (char !+))
             (vector-store memory ptr (add1 (vector-fetch memory ptr))))
            ((eqn op (char !-))
             (vector-store memory ptr (sub1 (vector-fetch memory ptr))))
            ((eqn op (char !.))
             (push (vector-fetch memory ptr) bfout))
            ((eqn op (char !,))
             (vector-store memory ptr (pop bfin)))
            ((eqn op (char ![))
             (if (zerop (vector-fetch memory ptr))
               (setq pc (bfseek bfprog pc 1 (char !])))))
            ((eqn op (char !]))
             (if (zerop (vector-fetch memory ptr))
               nil
               (setq pc (bfseek bfprog pc -1 (char ![)))))
            ((null op)
             (return nil)))
        (setq pc (add1 pc))
        (go top))

    (if (null bfout)
      ""
      (list2string (reverse bfout)))))

(de bfeval nil
  (dom-append (dom-get-element-by-id "out") "output: <br>"
    (bf (dom-get-value (dom-get-element-by-id "program"))
        (dom-get-value (dom-get-element-by-id "input"))) "<br>"))

(dom-set-title "slbrainfuck")

(dom-append (dom-get-body) 
  "program: " (dom-create-text '(("id" . "program"))) "<br>"
  "input: " (dom-create-text '(("id" . "input"))) "<br>"
  (dom-create-button "execute" nil '(("onclick" . (bfeval)))) "<br>"
  (dom-create "div" '(("id" . "out"))))

(dom-set-attribute (dom-get-element-by-id "program") "value" helloworld)

    </script>
  </head>
  <body>
  </body>
</html>
